#!/opt/local/bin/perl -w
use strict;

package ChadoPhen;
our (@ISA, @EXPORT, $VERSION);

use Exporter;
$VERSION= 1.00;
@ISA = qw(Exporter);
@EXPORT= qw (get_phen get_cvterms);
1;

require ChadoConnect;
my $dbh = ChadoConnect::make_con($ARGV[0]);

require ChadoCV;
my $cvterm_lookup = &ChadoCV::get_cvterm_lookup;

sub get_cvterm_lookup {
  return $cvterm_lookup
}

#### Defining Phen objects
# * Notes

# ** What to I need to be able to get out?

# uname
# primary_term (cv_id, name, obo_id) (so shouldn't this be a phenotype object itself?)
# qualifiers (cv_id, name, obo_id)
# uname
# pid
# type

{ 
  package Phen;
  use Moose;
#  use MooseX::StrictConstructor; # Prompts error if try to access undeclared Attribute / commented because of install problems. Uncomment once fixed.
  has 'type', is => 'rw', isa => 'Str';
  has 'uname', is => 'rw', isa => 'Str'; # Note rw - how to implement uniqueness?
  has 'primary_term', is => 'rw', isa => 'Item'; # - How to type this ????!!!!!  Choosing Item is a cop out !!!!! - But Object, Ref, HashRef, cvterm, ChadoCV::cvterm all consistently fail!  Maybe need some kind of export statement as these objects treated as private and so out of scope?

  has 'q_array', is => 'rw', isa => 'ArrayRef'; # ref to array of cvterm objects
  has 'pid', is => 'rw', isa => 'Str';
   
  sub roll_uname {
    my $self = shift;
    my $uname = $self->primary_term->name;
    my @qnames;
    my %q_lookup; # Quick hash lookup by name for qualifier cvterm objects
    for (@{$self->q_array}) {
      push @qnames, $_->name;
      $q_lookup{$_->name}=$_
    }
    my @sorted_q; # Re-ordered qualifier array
    my @sorted_qnames = sort (@qnames);  
    for (@sorted_qnames) {
      $uname .= ' | '.$_;
      push @sorted_q, $q_lookup{$_}
    }
    $self->uname = $uname;
    $self->q_array = \@sorted_q;
  }
}

# sub new_phen {
# #  Hmmmm - would be much easier if could just export object!
# }


### grab phen from chado

#### TODO: make object of all phens - allowing uname as an alternative key?
### Danger is that uname could be mutable, so would beed system to re-index.

sub get_phen {

  my $sth = $dbh->prepare('SELECT p.phenotype_id as pid, p.uniquename as uname, p.observable_id as anat, p.cvalue_id as phenc, pc.cvterm_id as q, pc.rank as qrank
FROM phenotype p
LEFT OUTER JOIN phenotype_cvterm pc ON  (p.phenotype_id=pc.phenotype_id)'); # Not all phenotypes have qualifiers

  $sth->execute or die "WARNING: ERR: Unable to execute query\n";
  my @q_array = ();
  my %phen; # An array of (references to) phenotype objects, keyed on phenotype_id.
  my %cvterm_phen; # A hash of arrays of phenotype keyed on cvterm_id
  
 ; # For initialisation purposes
  while (my $hash_ref = $sth->fetchrow_hashref) {
    my $pid = $hash_ref->{'pid'};
    #   $uname_id{ $hash_ref->{'uname'} } = $pid;
    $phen{$pid} = Phen->new( uname => $hash_ref->{'uname'}), unless ($phen{$pid}); # initialise with uname only, and only if not already initialised
    # Test of anat of phenc and set type and primary term accordingly
    unless ($hash_ref->{'anat'} eq '60468' ) { # 60468 is chado cvterm id for unspecified - perhaps better if this always comes in from cvterm module.
      $phen{$pid}->type('anat'), unless ($phen{$pid}->type);
      unless ($phen{$pid}->primary_term) {
	my $cvt_obj = $cvterm_lookup->cvterm_cid->{$hash_ref->{'anat'}};
	$phen{$pid}->primary_term($cvt_obj);
	push @{$cvterm_phen{$hash_ref->{'anat'}}}, $phen{$pid}
      }
    } elsif ($hash_ref->{'phenc'} ne '60468' ) { # 60468 is chado cvterm id for unspecified
      $phen{$pid}->type('phenc');
      unless ($phen{$pid}->primary_term) {
	my $cvt_obj = $cvterm_lookup->cvterm_cid->{$hash_ref->{'phenc'}};
	$phen{$pid}->primary_term($cvt_obj);
	push @{$cvterm_phen{$hash_ref->{'phenc'}}}, $phen{$pid};
      }
    } else {
      print STDERR "Phenotype with no known type id: $hash_ref->{'pid'}, uname: $hash_ref->{'uname'}\n";
    }
    if ($hash_ref->{'q'}) {
      unless ($phen{$pid}->q_array) {
      @q_array = ();
      $phen{$pid}->q_array(\@q_array); # Initialisation of array required
    }
      push @{$phen{$pid}->q_array}, $cvterm_lookup->cvterm_cid->{$hash_ref->{'q'}};   # Something very strange happening here....
      push @{$cvterm_phen{$hash_ref->{'q'}}}, $phen{$pid};
    }
  }
  return \%phen, \%cvterm_phen;
}
1;				# module must return true;
